;
;
sdrsp.ssckt equ 4
sdrsp.dnet equ 5
sdrsp.dnode equ 7
sdrsp.dsckt equ 8
sdrsp.flag equ 9
sdrsp.bitmap equ 10
sdrsp.tid equ 11
sdrsp.bdsadr equ 13
sdrsp.bdssiz equ 15
sdrsp.timer equ 16
;
getrq.dsckt equ 4
getrq.snet equ 5
getrq.snode equ 7
getrq.ssckt equ 8
getrq.flag equ 9
getrq.bitmap equ 10
getrq.tid equ 11
getrq.bdsadr equ 13
getrq.nxtptr equ 16
;
;
atpxobit equ $20
atpeombit equ $10
atpstsbit equ $08
atpchksum equ $01
;
openatpsckt equ *
 ldx #>atprplisten
 ldy #<atprplisten
 jmp getnscktno
;
;
;
atpsndresponse equ *
 php
 sei ; non-rentrant code does not allow interrupt
 ldy #sdrsp.ssckt
 lda (cmndlist),y
 jsr chkvalidsckt ; is it valid ?
 bne retasynflag ; bad socket error
 ldy #getrq.bitmap
 lda (cmndlist),y ; get buffer to be sent
 jsr sendnrsp ; send the n response
 pha ; save error flag
 jsr findrspcbindex ; see if rspcb exists
 bpl asndrsp.9 ; yes, wait for release
 pla ; not xo, get back error flag
 jmp retasynflag ; and return it
asndrsp.9 pla ; pop error flag and ignore it
 ldy #sdrsp.timer
 lda #120 ; 30 sec
 sta (cmndlist),y ; also reset timer
waitdone lda #$80 ; first indicates it is busy
retasynflag ldy #1
 sta (cmndlist),y
 ora #0 ; get status.
 bpl procdone ; if error or request complete call io complete routine.
 plp ; re-enable interrupt, otherwise wait for ever
 dey ; check for async
 lda (cmndlist),y
 bmi waitdn.9 ; branch if async done.
 iny
waitdn.1 equ *
 lda (cmndlist),y
 bmi waitdn.1
 sta status
waitdn.9 equ *
 rts
;
;
procdone plp  ; re-enable interrupts.
chkiocmp ldy #0
 lda (cmndlist),y
 bpl waitdn.9 ; no need if not asyn
 iny
 lda (cmndlist),y
 bmi waitdn.9 ; not yet completed
 iny
 lda (cmndlist),y
 sta execadr
 iny
 lda (cmndlist),y
 sta execadr+1
 beq waitdn.9 ; no completition routine
 ifne opers-prodos
 ldx cmndlist
 ldy cmndlist+1
 fin
; fall thru to doexecute
;
; since execadr is in zero page, it will be saved and restore during interrupt
; and it can be resued after the jmp indirect
doexecute jmp (execadr)
;
;
agetrequest equ *
 jsr killrspcb ; not needed, only as a caution against user mistake
 php
 sei
 ldy #getrq.dsckt
 lda (cmndlist),y ; get socket number
 jsr chkvalidsckt ; is it valid ?
 bne retasynflag ; bad socket error
 ldy #getrq.nxtptr+1
 lda #0
 sta (cmndlist),y ; zero it to make sure it is end of queue
 txa
 asl a
 tax
 lda atprptable+1,x
 beq getreq.3
 sta atprqptr+1
 lda atprptable,x
 sta atprqptr
 do safeclose
getreq.1 jsr nextinqueue ; find end of queue
 bne getreq.1 ; bra because y <> 0
 else
getreq.1 ldy #getrq.nxtptr+1
 lda (atprqptr),y
 beq getreq.2
 tax
 dey
 lda (atprqptr),y
 sta atprqptr
 stx atprqptr+1
 jmp getreq.1
 fin
getreq.2 lda cmndlist+1
 sta (atprqptr),y
 lda cmndlist
 dey ; also clear z flag
 sta (atprqptr),y
 bne waitdone ; bra
getreq.3 lda cmndlist
 sta atprptable,x
 lda cmndlist+1
 sta atprptable+1,x
 bne waitdone ; bra
;
 do safeclose
nextinqueue ldy #getrq.nxtptr+1
 lda (atprqptr),y
 beq nxtq.9
 tax
 dey
 lda (atprqptr),y
 sta atprqptr
 stx atprqptr+1
 iny ; point back to low byte, also clear z flag
nxtq.9 rts
 fin
;
;
findrspcbindex equ * ; return index into rspcbtable
 ldx #rspcbend ; check for rspcb
 lda #rspcbbegin
findtable sta frsp.2+1
frsp.1 dex
 dex
frsp.2 cpx #0 ; self modifying code
 bmi frsp.9
 lda cmndlist
 cmp processtable,x
 bne frsp.1
 lda cmndlist+1
 cmp processtable+1,x
 bne frsp.1
frsp.9 rts ;
;
atprplisten equ * ; listener for reply
 jsr rdatpheader ; read header and calculate checksum
 bne frsp.9 ; error, return with carry flag clear
 lda atpheader
 tax
 asl a ; check function
 bpl secrts ; request, ignore it
 bcs atprpls.3 ; release ; release xo
 txa
 and #atpxobit
 beq atprpls.4 ; not xo
 jsr lookrspcb ; check for duplicate
 sta atprpls.4a+1
 bmi atprpls.4 ; no, do it the normal way
 ldy #1
 lda (cmndlist),y ; are we ready ?
 bpl secrts ; no
; potential bug, we may need to check more
 lda atpheader+1 ; any request ?
 beq secrts ; no, ignore it
 ldy #sdrsp.bitmap
 and (cmndlist),y ; find repsonse needed
 beq *+5
 jmp sendnrsp
 lda #requestfail ; none of the request is available
 bne retasynsec ; bra to return as error
atprpls.3 jsr lookrspcb ; is it in table ?
 bmi secrts ; no, ignore it
 tax
 lda #0 ; also set error to 0
 sta processtable+1,x ; remove item from table
retasynsec ldy #1 ; return asyn result byte and also set carry
 sta (cmndlist),y
 jsr chkiocmp
secrts sec
 rts
atprpls.4 lda ddphead+ld.dsckt ; address to which socket
 jsr srchscktable
;bne secrts ; discard it, actually this is not possible
 txa
 asl a
 tax
 lda atprptable+1,x ; anything queue up ?
 beq secrts ; no discard it
 sta cmndlist+1
 lda atprptable,x
 sta cmndlist
 stx atprpls.5+1 ; save x reg for use later
 lda #0 ; it is the first bds
 ldy #getrq.bdsadr
 jsr readltdsize
 bne atprpls.8 ; checksum error, do not use it
 lda atpheader
 and #atpxobit ; is it xo ?
 beq atprpls.5 ; then no need to generate rsp cb
atprpls.4a lda #0 ; self modifying code, do we have one already
;
; note this is ok now, but if we ever change the process table
;   then we may have a bug
;
 bne atprpls.5 ; we already have a rsp cb
 ldy #rspcbsize*2
atprpls.4b dey
 dey
 bmi atprpls.8 ; don't do it unless we have room for rsp cb
 lda rspcbtable+1,y
 bne atprpls.4b
 lda cmndlist ; create a rspcb
 sta rspcbtable,y
 lda cmndlist+1
 sta rspcbtable+1,y
atprpls.5 ldx #0 ; self modifying code
 ldy #getrq.nxtptr ; remove front item from queue
 lda (cmndlist),y
 sta atprptable,x
 iny
 lda (cmndlist),y
 sta atprptable+1,x
 ldy #getrq.snet
atprpls.5a ldx rspcmptable+1-getrq.snet,y
 beq atprpls.5b
 lda dataarea,x
 sta (cmndlist),y
 iny
 bne atprpls.5a ; bra
atprpls.5b ldy #getrq.flag
atprpls.5c lda atpheader-getrq.flag,y
 sta (cmndlist),y
 iny
 cpy #getrq.tid+2
 bne atprpls.5c
 lda #0
 ldy #1
 sta (cmndlist),y
 jsr chkiocmp
atprpls.8 clc ; indicate we have processed it
 rts
;
lookrspcb equ *
 lda #rspcbend
 ldx #rspcbbegin
 ldy #ddphead+ld.snet-dataarea ; must check network number
 sty rspcmptable+1
 iny
 sty rspcmptable+2
looktable pha ; save index
 stx lkrsp.2+1
lkrsp.1 pla
 tax
 dex
 dex
 txa
lkrsp.2 cpx #0
 bmi lkrsp.5 ; return with n set
 pha
 lda processtable,x
 sta cmndlist
 lda processtable+1,x
 sta cmndlist+1
 beq lkrsp.1 ; empty, try next
 ldy #sdrsp.ssckt-1 ; coming from right address ?
lkrsp.3 iny
 ldx rspcmptable-sdrsp.ssckt,y
 beq lkrsp.3 ; don't care
 bmi lkrsp.4 ; end of list marker, this is it
 lda (cmndlist),y
 cmp dataarea,x
 beq lkrsp.3 ; agree, then check more
 bne lkrsp.1 ; no, try again
lkrsp.4 pla ; since acc is always positive, return with n clear
lkrsp.5 rts
;
rspcmptable equ *
 dfb ddphead+ld.dsckt-dataarea
 dfb ddphead+ld.snet-dataarea
 dfb ddphead+ld.snet+1-dataarea
 dfb ddphead+ld.snode-dataarea
 dfb ddphead+ld.ssckt-dataarea
 dfb 0,0
 dfb atpheader+2-dataarea
 dfb atpheader+3-dataarea
 dfb -1
;
;
;
;
sendnrsp equ *
 pha ; save the bit map to be sent
 lda #$80 ; response packet
 sta atpheader
 lda #$ff
 sta atpheader+1 ; start with response -1
sdrsp.1 pla ; get back bit map to be sent
 beq sdrsp.9 ; done
 inc atpheader+1
 lsr a ; move bit to carry
 pha
 bcc sdrsp.1 ; this buffer not needed
 bne sdrsp.2 ; not last buffer in sequence
 ldy #sdrsp.flag
 lda (cmndlist),y
 and #atpstsbit
 ora atpheader
 sta atpheader
sdrsp.2 lda atpheader+1
 tax
 adc #0 ; since carry is set (else bcc sdrsp.1), we increment acc by 1
 ldy #sdrsp.bdssiz
 cmp (cmndlist),y ; is this eom
 bcc sdrsp.3 ; not last, just send it
 bne sdrsp.1 ; not smaller or equal, then too big
 ldy #sdrsp.flag ; equal to last, then may need eom
 lda (cmndlist),y
 and #atpeombit
 ora atpheader
 sta atpheader
sdrsp.3 txa
 asl a ; * 2
 asl a ; * 4
 adc atpheader+1 ; *5
 asl a ; * 10
 jsr watppckt ; send an atp packet
 beq sdrsp.1 ; no error
 tax ; save error
 pla ; pop stack
 txa ; get back error
sdrsp.9 sec ; always return with carry set for cortland compatabliity
 rts
;
;
;
killrspcb php
 sei
 jsr findrspcbindex ; see if rspcb exists
 bmi *+7
 lda #0
 sta processtable+1,x ; remove item from table
 plp
 rts
